perm filename CC[GEM,BGB] blob sn#052873 filedate 1973-08-08 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ALTERNATE PDP-10 MNEMONICS.
C00005 00003	SAIL LIKE SUBROUTINE LINKAGE.
C00009 ENDMK
C⊗;
;ALTERNATE PDP-10 MNEMONICS.

	DEFINE O(A,B){OPDEF A[B]}
	O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
	O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
	O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
	O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
	O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
	O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
	O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
	O DZM,SETZM↔O DOM,SETOM↔O ZAC,SETZ↔O WAC,SETO
	O FLOAT,FSC 233↔O FLO,FSC 225↔O FIXX,FIX 233000

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.

	↓P←←17↔DEFINE POP0J <POPJ P,>
	↓POP1J.:SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
	↓POP4J.:SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.

	FOR @$ I←0,17{↓AC$I:0↔}
	DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
	DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
	DEFINE ACCUMULATORS(LIST){ACPTR←←2
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM: 0↔>}

;FATAL ERROR MESSAGE.
COMMENT |
	DEFINE FATAL(STR){JSR FATAL.↔JFCL[ASCIZ/STR/]}
	FATAL.:0↔OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
	CDR@FATAL.↔OUTSTR@↔INCHRW↔GO .-1↔LIT
|;
	EXTERNAL FATAL.,WARN.
	DEFINE FATAL(STR){PUSHJ P,FATAL.↔JFCL[ASCIZ|STR|]}
	DEFINE WARN (STR){PUSHJ P,WARN. ↔JFCL[ASCIZ|STR|]}
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
;SAIL LIKE SUBROUTINE LINKAGE.
DEFINE SUBR(NAME){HALT .↔XWD 777077,[SIXBIT|NAME|]↔INTERN NAME↔↓NAME: ;}
;DEFINE CALL(NAME,X1,X2,X3,X4){
;	IFDIF<><X1>{PUSH 17,X1↔IFDIF<><X2>{PUSH 17,X2
;	IFDIF<><X3>{PUSH 17,X3↔IFDIF<><X4>{PUSH 17,X4}}}}
;	IFDIF<><NAME>{PUSHJ 17,NAME}}

	DEFINE ARG1<-1(17)>↔DEFINE ARG2<-2(17)>
	DEFINE ARG3<-3(17)>↔DEFINE ARG4<-4(17)>
	DEFINE CAT $(A,B){A$B}		;CONCATENATION.
	FOR @$ I←0,16<AC.$I←I↔>		;ACCUMULATOR NAMES FOR RAID.
	.PLEVEL←←0	;PDL BACK POINTER.
	.SLEVEL←←0	;DEPTH OF NESTED SUBROUTINE DECLARATIONS.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
DEFINE $UBR(NAME,X1,X2,X3,X4,X5)
{BEGIN NAME↔INTERN NAME↔GLOBAL .PLEVEL↔GLOBAL .SLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
↓NAME:	;}
DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
DEFINE ENDR
{	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	LIT↔BLOCK 0↔BEND }
;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{	GLOBAL .SLEVEL,.PLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
	IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
	IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
	IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
	IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
	IFDIF<><NAME>{PUSHJ P,NAME }
	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
}
;PUSH SOMETHING ONTO STACK
	DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
	DEFINE POPP(ARG) {POP  P,ARG↔.PLEVEL←←.PLEVEL-1}
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}